shots = read.csv("data/data.csv", stringsAsFactors = T)
shots$shot_made_flag <- as.factor(shots$shot_made_flag)
train = shots[!is.na(shots$shot_made_flag),]
test = shots[is.na(shots$shot_made_flag),]
Une fois le chargement des données effectuées dans la variable shots, on peut distinguer deux jeux de données : - train : les shots où l’on connaît la réussite du tir, - test : les shots où l’on ne connaît pas la réussite du tir.
names(shots)
## [1] "action_type" "combined_shot_type" "game_event_id"
## [4] "game_id" "lat" "loc_x"
## [7] "loc_y" "lon" "minutes_remaining"
## [10] "period" "playoffs" "season"
## [13] "seconds_remaining" "shot_distance" "shot_made_flag"
## [16] "shot_type" "shot_zone_area" "shot_zone_basic"
## [19] "shot_zone_range" "team_id" "team_name"
## [22] "game_date" "matchup" "opponent"
## [25] "shot_id"
summary(shots)
## action_type combined_shot_type game_event_id
## Jump Shot :18880 Bank Shot: 141 Min. : 2.0
## Layup Shot : 2567 Dunk : 1286 1st Qu.:110.0
## Driving Layup Shot : 1978 Hook Shot: 153 Median :253.0
## Turnaround Jump Shot: 1057 Jump Shot:23485 Mean :249.2
## Fadeaway Jump Shot : 1048 Layup : 5448 3rd Qu.:368.0
## Running Jump Shot : 926 Tip Shot : 184 Max. :659.0
## (Other) : 4241
## game_id lat loc_x loc_y
## Min. :20000012 Min. :33.25 Min. :-250.000 Min. :-44.00
## 1st Qu.:20500077 1st Qu.:33.88 1st Qu.: -68.000 1st Qu.: 4.00
## Median :20900354 Median :33.97 Median : 0.000 Median : 74.00
## Mean :24764066 Mean :33.95 Mean : 7.111 Mean : 91.11
## 3rd Qu.:29600474 3rd Qu.:34.04 3rd Qu.: 95.000 3rd Qu.:160.00
## Max. :49900088 Max. :34.09 Max. : 248.000 Max. :791.00
##
## lon minutes_remaining period playoffs
## Min. :-118.5 Min. : 0.000 Min. :1.000 Min. :0.0000
## 1st Qu.:-118.3 1st Qu.: 2.000 1st Qu.:1.000 1st Qu.:0.0000
## Median :-118.3 Median : 5.000 Median :3.000 Median :0.0000
## Mean :-118.3 Mean : 4.886 Mean :2.519 Mean :0.1466
## 3rd Qu.:-118.2 3rd Qu.: 8.000 3rd Qu.:3.000 3rd Qu.:0.0000
## Max. :-118.0 Max. :11.000 Max. :7.000 Max. :1.0000
##
## season seconds_remaining shot_distance shot_made_flag
## 2005-06: 2318 Min. : 0.00 Min. : 0.00 0 :14232
## 2008-09: 2242 1st Qu.:13.00 1st Qu.: 5.00 1 :11465
## 2002-03: 2241 Median :28.00 Median :15.00 NA's: 5000
## 2007-08: 2153 Mean :28.37 Mean :13.44
## 2009-10: 2080 3rd Qu.:43.00 3rd Qu.:21.00
## 2001-02: 2028 Max. :59.00 Max. :79.00
## (Other):17635
## shot_type shot_zone_area
## 2PT Field Goal:24271 Back Court(BC) : 83
## 3PT Field Goal: 6426 Center(C) :13455
## Left Side Center(LC) : 4044
## Left Side(L) : 3751
## Right Side Center(RC): 4776
## Right Side(R) : 4588
##
## shot_zone_basic shot_zone_range team_id
## Above the Break 3 : 5620 16-24 ft. :8315 Min. :1.611e+09
## Backcourt : 71 24+ ft. :6275 1st Qu.:1.611e+09
## In The Paint (Non-RA): 4578 8-16 ft. :6626 Median :1.611e+09
## Left Corner 3 : 280 Back Court Shot: 83 Mean :1.611e+09
## Mid-Range :12625 Less Than 8 ft.:9398 3rd Qu.:1.611e+09
## Restricted Area : 7136 Max. :1.611e+09
## Right Corner 3 : 387
## team_name game_date matchup
## Los Angeles Lakers:30697 2016-04-13: 50 LAL @ SAS : 1020
## 2002-11-07: 47 LAL vs. SAS: 936
## 2006-01-22: 46 LAL @ SAC : 889
## 2006-12-29: 45 LAL vs. HOU: 878
## 2007-03-30: 44 LAL @ DEN : 873
## 2008-01-14: 44 LAL @ PHX : 859
## (Other) :30421 (Other) :25242
## opponent shot_id
## SAS : 1978 Min. : 1
## PHX : 1781 1st Qu.: 7675
## HOU : 1666 Median :15349
## SAC : 1643 Mean :15349
## DEN : 1642 3rd Qu.:23023
## POR : 1539 Max. :30697
## (Other):20448
str(shots)
## 'data.frame': 30697 obs. of 25 variables:
## $ action_type : Factor w/ 57 levels "Alley Oop Dunk Shot",..: 27 27 27 27 6 27 28 27 27 42 ...
## $ combined_shot_type: Factor w/ 6 levels "Bank Shot","Dunk",..: 4 4 4 4 2 4 5 4 4 4 ...
## $ game_event_id : int 10 12 35 43 155 244 251 254 265 294 ...
## $ game_id : int 20000012 20000012 20000012 20000012 20000012 20000012 20000012 20000012 20000012 20000012 ...
## $ lat : num 34 34 33.9 33.9 34 ...
## $ loc_x : int 167 -157 -101 138 0 -145 0 1 -65 -33 ...
## $ loc_y : int 72 0 135 175 0 -11 0 28 108 125 ...
## $ lon : num -118 -118 -118 -118 -118 ...
## $ minutes_remaining : int 10 10 7 6 6 9 8 8 6 3 ...
## $ period : int 1 1 1 1 2 3 3 3 3 3 ...
## $ playoffs : int 0 0 0 0 0 0 0 0 0 0 ...
## $ season : Factor w/ 20 levels "1996-97","1997-98",..: 5 5 5 5 5 5 5 5 5 5 ...
## $ seconds_remaining : int 27 22 45 52 19 32 52 5 12 36 ...
## $ shot_distance : int 18 15 16 22 0 14 0 2 12 12 ...
## $ shot_made_flag : Factor w/ 2 levels "0","1": NA 1 2 1 2 1 2 NA 2 1 ...
## $ shot_type : Factor w/ 2 levels "2PT Field Goal",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ shot_zone_area : Factor w/ 6 levels "Back Court(BC)",..: 6 4 3 5 2 4 2 2 4 2 ...
## $ shot_zone_basic : Factor w/ 7 levels "Above the Break 3",..: 5 5 5 5 6 5 6 6 3 3 ...
## $ shot_zone_range : Factor w/ 5 levels "16-24 ft.","24+ ft.",..: 1 3 1 1 5 3 5 5 3 3 ...
## $ team_id : int 1610612747 1610612747 1610612747 1610612747 1610612747 1610612747 1610612747 1610612747 1610612747 1610612747 ...
## $ team_name : Factor w/ 1 level "Los Angeles Lakers": 1 1 1 1 1 1 1 1 1 1 ...
## $ game_date : Factor w/ 1559 levels "1996-11-03","1996-11-05",..: 311 311 311 311 311 311 311 311 311 311 ...
## $ matchup : Factor w/ 74 levels "LAL @ ATL","LAL @ BKN",..: 29 29 29 29 29 29 29 29 29 29 ...
## $ opponent : Factor w/ 33 levels "ATL","BKN","BOS",..: 26 26 26 26 26 26 26 26 26 26 ...
## $ shot_id : int 1 2 3 4 5 6 7 8 9 10 ...
Ces fonctions nous permettent de mieux connaitre notre jeu de données. On voit que l’on a la position du tir sur le terrain, s’il s’agit d’un tir à 2 points, à 3 points, l’équipe adverse, Enormement fournis, le type de tir, etc. Nous reviendrons sur certaines de ces variables plus tard. Une chose remarquable à noter pour une étude statistiques est que il n’y a pas de donnée manquante.
Pour mieux appréhender nos données, une bonne solution est de visualiser nos données. Pour ce faire, nous définissons une fonction qui permet de représenter une variable en fonction de la position du tir sur le terrain.
courtplot <- function(feat) {
feat <- substitute(feat)
train %>%
ggplot(aes(x = lon, y = lat)) +
geom_point(aes_q(color = feat), alpha = 0.7, size = 3) +
ylim(c(33.7, 34.0883)) +
theme_void() +
ggtitle(paste(feat))
}
Est-ce qu’il existe un lien fort entre la position du tir et sa réussite ? Voyons ça :
courtplot(shot_made_flag)
## Warning: Removed 105 rows containing missing values (geom_point).
Nous obtenons une jolie représentation des tirs! On voit que Kobe Bryant a pris des tirs à peu prés partout sur un demi-terrain. On peut également voir une proéminence de la couleur rouge, qui indique un tir manqué. On peut noté aussi que Kobe a pris quelques “big deeper” et qu’il a y eu plus d’échec que de réussite.
On dispose d’une variable zone_shot_area. On peut aisément la représenter :
courtplot(shot_zone_area)
## Warning: Removed 105 rows containing missing values (geom_point).
On voit que nous n’avons que 6 zones, ce qui est peu. Cinq zones englobent des tirs à 2 et 3 points et la zone “Back Court” n’apparait pas sur le graphique. Les tirs’Back court’ sont les tirs pris dans la zone adverse. Il existe aussi une variable shot_zone_basic :
courtplot(shot_zone_basic)
## Warning: Removed 105 rows containing missing values (geom_point).
On voit le même problème que précédemment, la zone ‘Backcourt’ n’est pas représentée et certaines zones sont très larges. En fouillant sur le site http://stats.nba.com/, on peut trouver une représentation du terrain découpé en 14 zones.
On peut alors introduire une nouvelle variable pour avoir un découpage du terrain comme sur l’image. En utilisant les positions du tir, si le tir est à 2 ou 3 points, on peut créer les 14 zones.
train$shot_zone_detailed <- NA
train$shot_zone_detailed[train$loc_x <= -220 & train$loc_y <= 100 & train$shot_type == "3PT Field Goal"] = "A"
train$shot_zone_detailed[train$loc_x >= -220 & train$loc_x <= -150 & train$loc_y <= 100 & train$shot_type == "2PT Field Goal"] = "B"
train$shot_zone_detailed[train$loc_x < -90 & train$shot_type == "3PT Field Goal" & train$loc_y > 100] = "C"
train$shot_zone_detailed[train$loc_x < 90 & train$loc_x > -90 & train$shot_type == "3PT Field Goal"] = "D"
train$shot_zone_detailed[train$loc_x < 70 & train$loc_x > -70 & train$loc_y > 150 & train$shot_type == "2PT Field Goal"] = "F"
train$shot_zone_detailed[train$loc_x > 70 & train$shot_type == "3PT Field Goal"] = "G"
train$shot_zone_detailed[train$loc_x < 90 & train$loc_x > -90 & train$loc_y > 90 & train$loc_y < 150 & train$shot_type == "2PT Field Goal"] = "J"
train$shot_zone_detailed[sqrt(train$loc_x^2 + train$loc_y^2) < 90] = "L"
train$shot_zone_detailed[train$loc_x < 220 & train$loc_x > 150 & train$loc_y <= 100] = "M"
train$shot_zone_detailed[train$loc_x > 220 & train$loc_y < 100 & train$shot_type == "3PT Field Goal"] = "N"
train$shot_zone_detailed[is.na(train$shot_zone_detailed) & train$loc_y > 100 & train$loc_x > -210 & train$loc_x < 70] = "E"
train$shot_zone_detailed[is.na(train$shot_zone_detailed) & train$loc_y > 100 & train$loc_x >= 70 & train$loc_x < 210] = "H"
train$shot_zone_detailed[is.na(train$shot_zone_detailed) & train$loc_y <= 100 & train$loc_x < 0] = "I"
train$shot_zone_detailed[is.na(train$shot_zone_detailed) & train$loc_y <= 100 & train$loc_x > 0] = "K"
courtplot(shot_zone_detailed)
## Warning: Removed 105 rows containing missing values (geom_point).
On peut ensuite visualiser cette variable
courtplot(shot_zone_detailed)
## Warning: Removed 105 rows containing missing values (geom_point).
Super! Pour le fun, on peut s’intéresser au pourcentage de réussite d’un joueur professionnel sur toute sa carrière. On commence par calculer la moyenne des coordonnées des positions par zone pour pouvoir représenter nos chiffres :
mean_x = aggregate(train$loc_x, list(train$shot_zone_detailed), na.rm = TRUE, mean)
mean_y = aggregate(train$loc_y, list(train$shot_zone_detailed), na.rm = TRUE, mean)
mean_xy = data.frame(mean_x$Group.1, mean_x$x, mean_y$x)
On calcule ensuite le pourcentage de réussite par zone, ainsi que le nombre de tirs par zone :
pourcentage_shot = as.data.frame(prop.table(table(train$shot_made_flag, train$shot_zone_detailed), 2))
shot_made_by_zone = as.data.frame(table(train$shot_made_flag, train$shot_zone_detailed))
On peut ensuite représenter nos pourcentages :
courtimg = readPNG('court.png')
plot(1, type="n", xlab="", ylab="", xlim=c(-235, 235), ylim=c(-30, 400))
lim <- par()
rasterImage(courtimg, lim$usr[1], lim$usr[3], lim$usr[2], lim$usr[4])
grid()
for (zone in c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")) {
x = mean_xy[mean_xy$mean_x.Group.1 == zone,]$mean_x.x
y = mean_xy[mean_xy$mean_x.Group.1 == zone,]$mean_y.x
text_pourcentage = pourcentage_shot[pourcentage_shot$Var1 == 1 & pourcentage_shot$Var2 == zone,]$Freq
success_shot = shot_made_by_zone[shot_made_by_zone$Var2 == zone & shot_made_by_zone$Var1 == 1,]$Freq
missed_shot = shot_made_by_zone[shot_made_by_zone$Var2 == zone & shot_made_by_zone$Var1 == 0,]$Freq
text(x, y, sprintf("%d%% \n %d / %d", round(text_pourcentage * 100), success_shot, success_shot + missed_shot))
}
Black Mamba était-il un shoteur à 3 points comme Stefen Curry ? Au vue des pourcentages de shot précédents, on peut rapidement estimer un pourcentage de 30% de réussite à 3 pts. Vérifions-ça :
prop.table(table(train$shot_made_flag, train$shot_type))
##
## 2PT Field Goal 3PT Field Goal
## 0 0.41257734 0.14126163
## 1 0.37681441 0.06934662
prop.table(table(train$shot_made_flag, train$shot_type), 2)
##
## 2PT Field Goal 3PT Field Goal
## 0 0.5226522 0.6707317
## 1 0.4773478 0.3292683
Pour approximativement 21% de shots pris à 3 points, 33% de réussite! Pour les tirs à 2pts, 52% de manqués contre 47% de succès. Le tir à 2 pts ne nous aidera pas à déterminer la réussite du tir.
Intéressons nous maintenant à la distance de tir. Nous disposons de deux variables pour ce faire : shot_zone_range, shot_distance.
courtplot(shot_zone_range)
## Warning: Removed 105 rows containing missing values (geom_point).